Libris Britannia 4/science library(b).zip/science library(b)/PROGRAMM/DB_CLIPP/1159.ZIP/REPINSTP.PRG

Text File | 1987-02-06 | 12KB | 598 lines

IF GLPRINT=1
 PAPEROUT=1
ENDIF
DO CASE
 CASE MULTTV=1.AND.MODFILE=0
  CLOSE DATABASES
  SELECT 2
  USE REPWORK
  SELECT 1
  USE &DBNAME INDEX &INDEX1,&INDEX2
  SEEK TVANO
IF EOF()
 CLEAR
 @ 1,20 SAY 'Data base in use:  '
 ?? OSS
 @ 5,0 SAY 'No record was found in which "'
 ?? TVANO
 ??'" exactly '
 ?'matched any item in the '
 ?? TVANUMBER
 ??' field.'
 ?
 ?
 ?
 WAIT
 RETURN
ENDIF
  DO WHILE TVANO=TVA_NO
   SELECT 2
   APPEND BLANK
   REPLACE SUBCATID WITH A->SUBCATID
   REPLACE INST_TYPE WITH A->INST_TYPE
   REPLACE TVA_NO WITH A->TVA_NO
   REPLACE SERIAL_NO WITH A->SERIAL_NO
   REPLACE BY_DATE WITH A->BY_DATE
   REPLACE CALIB_DATE WITH A->CALIB_DATE
   REPLACE CAL_DUE_DT WITH A->CAL_DUE_DT
   REPLACE LOCATION WITH A->LOCATION
   REPLACE REMARK WITH A->REMARK
   REPLACE CALIB_INT WITH A->CALIB_INT
   REPLACE LAST_UPDAT WITH A->LAST_UPDAT
   SELECT 1
   SKIP
  ENDDO
  SELECT 2
 CASE MULTSN=1.AND.MODFILE=0
  CLOSE DATABASES
  SELECT 2
  USE REPWORK
  SELECT 1
  USE &DBNAME INDEX &INDEX2,&INDEX1
  SEEK TVANO
IF EOF()
 CLEAR
 @ 1,20 SAY 'Data base in use:  '
 ?? OSS
 @ 5,0 SAY 'No record was found in which "'
 ?? TVANO
 ??'" exactly '
 ?'matched any item in the '
 ?? SERIALNUM
 ??' field.'
 ?
 ?
 ?
 WAIT
 RETURN
ENDIF
  DO WHILE TVANO=SERIAL_NO
   SELECT 2
   APPEND BLANK
   REPLACE SUBCATID WITH A->SUBCATID
   REPLACE INST_TYPE WITH A->INST_TYPE
   REPLACE TVA_NO WITH A->TVA_NO
   REPLACE SERIAL_NO WITH A->SERIAL_NO
   REPLACE BY_DATE WITH A->BY_DATE
   REPLACE CALIB_DATE WITH A->CALIB_DATE
   REPLACE CAL_DUE_DT WITH A->CAL_DUE_DT
   REPLACE LOCATION WITH A->LOCATION
   REPLACE REMARK WITH A->REMARK
   REPLACE CALIB_INT WITH A->CALIB_INT
   REPLACE LAST_UPDAT WITH A->LAST_UPDAT
   SELECT 1
   SKIP
  ENDDO
  SELECT 2
ENDCASE
IF GLCALDU=0
  SET FILTER TO CALIB_INT#0 .AND. CALIB_INT#99
ELSE
  SET FILTER TO COMPDATE1<=CAL_DUE_DT.AND.COMPDATE2>=CAL_DUE_DT.AND.;
BY_DATE>10
ENDIF
GO TOP
NNN=0
N99=0
NN=0
IF PRINTOUT=1
 READY='K'
 DO WHILE READY#'Y'
  IF GLCALDU=0
  CLEAR
  ?
  ?'Make SURE the printer is ready to print.  Then press "Y" to continue,'
  ?
  ?'or else press "RETURN" to return to a previous menu.'
  ?
  ?
  ?'PLEASE NOTE:  If you should ever make a mistake and there is a system error'
  ?'because the printer is not ready, then FIRST enable the printer and THEN'
  ?'press "I" for the "ignor" option until no further error is indicated.'
  IF ADDFILE=1.OR.MODFILE=1
  ?'Since you are involved in a record modification routine at this time, any'
  ?'other response may damage the records to this particular data base and'
  ?'cause you to have to restore the records to this data base from a backup'
  ?'copy.  For further information, please see the instruction manual.'
  ENDIF
  ?
  ?
  CLEAR TYPEAHEAD
  WAIT '                                    ' TO READY
  READY=UPPER(READY)
  IF ASC(READY)=0
   SET DELETED ON
   IF (MULTTV=1.OR.MULTSN=1).AND.MODFILE=0
    ZAP
    USE
    SELECT 1
   ENDIF
   RETURN
  ENDIF
  ELSE
   READY='Y'
  ENDIF
 ENDDO
ENDIF
 CLEAR
 @ 4,35 SAY 'WORKING . . .'
 @ 14,20 SAY 'Data base in use:'
 @ 14,38 SAY OSS
 IF PRINTOUT=1
 N=5
 SET CONSOLE OFF
 SET PRINT ON
 SET DEVICE TO PRINT
 DO CASE
   CASE ADDFILE=1
 IF PDELREC=0
   @ 1,45 SAY "These are the records you just added."
  ELSE
   @ 1,42 SAY "These are the records which were just deleted."
 ENDIF
   CASE MODFILE=1
 IF PDELREC=0
   @ 1,44 SAY "These are the records you just modified."
  ELSE
   @ 1,44 SAY "These are the records you just deleted."
 ENDIF
   CASE GLCALDU=1
   @ 1,65-INT((LEN(DUEDATE)+62)/2) SAY 'Conditions:  Records with '
   ?? DUEDATE
   ??' field from  '
   ?? COMPDATE1
   ??'  to  '
   ?? COMPDATE2
   ??'.'
 ENDCASE
 @ 3,65-INT(LEN(TITLE1)/2) SAY TITLE1
 @ 3,105 SAY "Today's date is"
 @ 3,122 SAY DATE()
 @ 3,130 SAY '.'
 DO WHILE NN=0
 DO WHILE .NOT. EOF()
  DO CASE
   CASE NNN=0
 IF INSTNAME#'.'
  @ N,0 SAY INSTNAME
 ENDIF
 IF SERIALNUM#'.'
  @ N,21 SAY SERIALNUM
 ENDIF
 IF TVANUMBER#'.'
  @ N,36 SAY TVANUMBER
 ENDIF
 IF CALIBDATE#'.'
  @ N,51 SAY CALIBDATE
 ENDIF
 IF DUEDATE#'.'
  @ N,61 SAY DUEDATE
 ENDIF
 IF LOCATNAME#'.'
  @ N,95 SAY LOCATNAME
 ENDIF
 IF CALINTERVL#'.'
  @ N,110 SAY CALINTERVL
 ENDIF
  @ N,120 SAY 'LAST UPDATE'
 IF CALINTERVL#'.'
  @ N+1,110 SAY '(months)'
 ENDIF
  @ N+2,0 SAY ' '
   CASE NNN=1
   ?
   DO CASE
    CASE PROW()>53
     @ 0,65-INT((LEN(CATEGORY2+CATEGORY3)+67)/2) SAY 'THESE RECORDS ARE;
 EITHER PRESENTLY IN CATEGORY "'
     ?? CATEGORY2
     ??'" OR IN CATEGORY "'
     ?? CATEGORY3
     ??'"'
    OTHERWISE
     @ PROW(),65-INT((LEN(CATEGORY2+CATEGORY3)+67)/2) SAY 'THESE RECORDS ARE;
 EITHER PRESENTLY IN CATEGORY "'
     ?? CATEGORY2
     ??'" OR IN CATEGORY "'
     ?? CATEGORY3
     ??'"'
   ENDCASE
  IF INSTNAME#'.'
   @ PROW()+2,0 SAY INSTNAME
  ENDIF
  IF SERIALNUM#'.'
   @ PROW(),21 SAY SERIALNUM
  ENDIF
  IF TVANUMBER#'.'
   @ PROW(),36 SAY TVANUMBER
  ENDIF
  IF CALIBDATE#'.'
   @ PROW(),51 SAY CALIBDATE
  ENDIF
  IF DUEDATE#'.'
   @ PROW(),63 SAY DUEDATE
  ENDIF
  IF LOCATNAME#'.'
   @ PROW(),95 SAY LOCATNAME
  ENDIF
   @ PROW(),120 SAY 'LAST UPDATE'
   ?
   ?
  ENDCASE
  DO WHILE .NOT. EOF()
  DO CASE
   CASE NNN=0
    IF PROW()>53
     EXIT
    ENDIF
    DO CASE
     CASE BY_DATE=100
      @ PROW()+1,51 SAY TDREMARK
     CASE BY_DATE=200
      @ PROW()+1,51 SAY DREMARK
    ENDCASE
    @ PROW()+1,0 SAY INST_TYPE
    @ PROW(),21 SAY SERIAL_NO
    @ PROW(),36 SAY TVA_NO
    @ PROW(),51 SAY CALIB_DATE
    @ PROW(),61 SAY CAL_DUE_DT
    @ PROW(),70 SAY CDOW(CAL_DUE_DT)
    ??', '
    ?? CMONTH(CAL_DUE_DT)
    ?? DAY(CAL_DUE_DT)
    @ PROW(),95 SAY LOCATION
    @ PROW(),113 SAY CALIB_INT
    @ PROW(),121 SAY LAST_UPDAT
  PT=0
  IF CAT3ABB $ SUBCATID
   ?'/'
   ?? CATEGORY3
   ??'/   '
   PT=1
  ENDIF
  IF SUB1ABB $ SUBCATID
   IF PT=0
    ?'('
    ?? SUBCAT1
    ??')   '
    PT=1
   ELSE
    ??'('
    ?? SUBCAT1
    ??')   '
   ENDIF
  ENDIF
  IF SUB2ABB $ SUBCATID
   IF PT=0
    ?'('
    ?? SUBCAT2
    ??')   '
    PT=1
   ELSE
    ??'('
    ?? SUBCAT2
    ??')   '
   ENDIF
  ENDIF
  IF SUB3ABB $ SUBCATID
   IF PT=0
   ?'('
   ?? SUBCAT3
   ??')   '
   ELSE
   ??'('
   ?? SUBCAT3
   ??')   '
   ENDIF
  ENDIF
    IF LEN(TRIM(REMARK))#0
     ? TRIM(REMARK)
    ENDIF
   CASE NNN=1
    IF PROW()>53
     EXIT
    ENDIF
    @ PROW()+1,0 SAY INST_TYPE
    @ PROW(),21 SAY SERIAL_NO
    @ PROW(),36 SAY TVA_NO
    REMKE=LTRIM(TRIM(REMARK))
   IF DTOC(CALIB_DATE) # '  /  /  ' .OR. CALIBDATE # '.'
    @ PROW(),51 SAY CALIB_DATE
   ENDIF
   IF DTOC(CAL_DUE_DT) # '  /  /  ' .OR. DUEDATE # '.'
    @ PROW(),69 SAY CAL_DUE_DT
   ENDIF
    DO CASE
     CASE CALIB_INT=99
      @ PROW(),78 SAY CATEGORY2
     CASE CALIB_INT=0
      @ PROW(),78 SAY CATEGORY3
    ENDCASE
    @ PROW(),95 SAY LOCATION
    @ PROW(),121 SAY LAST_UPDAT
  PT=0
  IF CAT3ABB $ SUBCATID
   ?'/'
   ?? CATEGORY3
   ??'/   '
   PT=1
  ENDIF
  IF SUB1ABB $ SUBCATID
   IF PT=0
    ?'('
    ?? SUBCAT1
    ??')   '
    PT=1
   ELSE
    ??'('
    ?? SUBCAT1
    ??')   '
   ENDIF
  ENDIF
  IF SUB2ABB $ SUBCATID
   IF PT=0
    ?'('
    ?? SUBCAT2
    ??')   '
    PT=1
   ELSE
    ??'('
    ?? SUBCAT2
    ??')   '
   ENDIF
  ENDIF
  IF SUB3ABB $ SUBCATID
   IF PT=0
   ?'('
   ?? SUBCAT3
   ??')   '
   ELSE
   ??'('
   ?? SUBCAT3
   ??')   '
   ENDIF
  ENDIF
    IF LEN(REMKE)>0
      ? REMKE
    ENDIF
    N99=0
ENDCASE
  SKIP
  NSPC=1
  DO WHILE NSPC<SPACING
  ?
  NSPC=NSPC+1
  ENDDO
 ENDDO
  ?
N=0
ENDDO
IF NNN=0
 IF GLCALDU=0
SET FILTER TO CALIB_INT=0 .OR. CALIB_INT=99
 ELSE
  SET FILTER TO COMPDATE1<=CAL_DUE_DT.AND.COMPDATE2>=CAL_DUE_DT.AND.;
BY_DATE<10
 ENDIF
GO TOP
 IF .NOT. EOF()
  N99=1
 ENDIF
ENDIF
NNN=1
IF N99=0
 NN=1
ENDIF
?'****************************************************************************;
*******************************************************'
IF N99=1 .AND. NNN=1 .AND. PROW()>43
 @ 0,0 SAY ' '
ENDIF
ENDDO
?
?'****************************************************************************;
*******************************************************'
?
?'                                                        END OF LISTING'
NPRN=0
DO WHILE NPRN<PAPEROUT
?
NPRN=NPRN+1
ENDDO
SET CONSOLE ON
SET DEVICE TO SCREEN
SET PRINT OFF
ENDIF
IF VIEW=1
SET FILTER TO
ENDREC=RECCOUNT()
GO TOP
DO WHILE .NOT. EOF()
SET CONSOLE ON
CLEAR
DO CASE
 CASE ENDREC # 1
  @ 1,7+INT(LOG(ENDREC)/LOG(10))+INT(LOG(RECNO())/LOG(10)) SAY ENDREC
  ??' records.       '
  ??'Data base in use:  '
  ?? OSS
  @ 1,2+INT(LOG(RECNO())/LOG(10)) SAY RECNO()
  ??' of '
  @ 1,0 SAY 'Record No.'
  DO CASE
   CASE RECNO()=ENDREC
    ?'End of listing'
   CASE RECNO()=1
    ?'Beginning of listing'
  ENDCASE
   CASE ENDREC=1
    ?'There is only 1 record in this listing.'
ENDCASE
@ 3,0 SAY INSTNAME
@ 3,23 SAY SERIALNUM
@ 3,40 SAY TVANUMBER
@ 3,57 SAY CALIBDATE
@ 3,70 SAY 'NEXT DATE'
DO CASE
 CASE BY_DATE=100
  @ 5,56 SAY TDREMARK
 CASE BY_DATE=200
  @ 5,58 SAY DREMARK
ENDCASE
@ 6,0 SAY INST_TYPE
@ 6,23 SAY SERIAL_NO
@ 6,40 SAY TVA_NO
@ 6,58 SAY CALIB_DATE
@ 6,70 SAY CAL_DUE_DT
  PT=0
  IF CAT3ABB $ SUBCATID
   ?'/'
   ?? CATEGORY3
   ??'/   '
   PT=1
  ENDIF
  IF SUB1ABB $ SUBCATID
   IF PT=0
    ?'('
    ?? SUBCAT1
    ??')   '
    PT=1
   ELSE
    ??'('
    ?? SUBCAT1
    ??')   '
   ENDIF
  ENDIF
  IF SUB2ABB $ SUBCATID
   IF PT=0
    ?'('
    ?? SUBCAT2
    ??')   '
    PT=1
   ELSE
    ??'('
    ?? SUBCAT2
    ??')   '
   ENDIF
  ENDIF
  IF SUB3ABB $ SUBCATID
   IF PT=0
   ?'('
   ?? SUBCAT3
   ??')   '
   PT=1
   ELSE
   ??'('
   ?? SUBCAT3
   ??')   '
   ENDIF
  ENDIF
@ 9,0 SAY LOCATNAME
??':  '
?? LOCATION
IF CALIB_INT>0.AND.CALIB_INT<99
 ??'   '
 ?? CALINTERVL
 ??':  '
 ?? CALIB_INT
 ??'  months'
ENDIF
DO CASE
 CASE CALIB_INT=99
  @ 9,60 SAY '/'
  ?? CATEGORY2
  ??'/'
 CASE CALIB_INT=0
  @ 9,60 SAY '/'
  ?? CATEGORY3
  ??'/'
ENDCASE
@ 11,0 SAY REMARK
@ 14,0 SAY 'LAST UPDATE:'
@ 14,14 SAY LAST_UPDAT
N4="K"
DO WHILE ASC(N4)#0.AND.N4#' ' .AND.;
N4#'P'.AND.N4#'U'.AND.N4#'D'.AND.N4#'E'.AND.N4#'B'
@ 16,0 SAY 'Press SPACEBAR to see the next record.'
@ 17,0 SAY 'Press "P" to see previous record.'
IF ENDREC>7
  ?'Press "U" to go up 7 records.'
  ?'Press "D" to go down 7 records.'
ENDIF
?'Press "E" to go to the ending (last) record.'
?'Press "B" to go to the beginning (first) record.'
?
WAIT 'Press "RETURN" to return to a previous menu.' TO N4
N4=UPPER(N4)
ENDDO
DO CASE
 CASE N4='P' .AND. RECNO() # 1
  GO RECNO()-1
 CASE N4='P' .AND. RECNO() = 1
  GO BOTTOM
 CASE ASC(N4)=0
  IF (MULTTV=1.OR.MULTSN=1).AND.MODFILE=0
   ZAP
   USE
   SELECT 1
  ENDIF
  RETURN
 CASE N4=' '.AND.ENDREC=RECNO()
  GO TOP
 CASE N4=' '
  SKIP
 CASE N4='D'
  IF ENDREC>7
   IF ENDREC-RECNO()>6
    GO RECNO()+7
   ELSE
    GO RECNO()+7-ENDREC
   ENDIF
  ELSE
   N4='Z'
  ENDIF
 CASE N4='U'
  IF ENDREC>7
   IF RECNO()>7
    GO RECNO()-7
   ELSE
    GO ENDREC-7+RECNO()
   ENDIF
  ELSE
    N4='Z'
  ENDIF
 CASE N4='E'
  GO BOTTOM
 CASE N4='B'
  GO TOP
ENDCASE
ENDDO
ENDIF
SET DELETED ON
IF (MULTTV=1.OR.MULTSN=1).AND.MODFILE=0
 ZAP
 USE
 SELECT 1
ENDIF
RETURN